home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d16 / prvw12.arc / PREVIEW.PAS < prev    next >
Pascal/Delphi Source File  |  1991-07-10  |  18KB  |  580 lines
  1. {Font Preview - 1.2 Program Copyright (C) Doug Overmyer 7/8/91}
  2. program PREVIEW;
  3.  
  4. {$S-}
  5. {$R PREVIEW.RES}
  6. uses WinTypes, WinProcs, WinDos, Strings, WObjects,WOPlus,WFPlus,StdDlgs;
  7.  
  8. const
  9.   id_But1    = 201;
  10.   id_But2    = 202;
  11.   id_But3    = 203;
  12.   id_But4    = 204;
  13.   id_But5    = 205;
  14.   id_Lb1     = 301;
  15.   id_lb2     = 302;
  16.   id_St1     = 401;
  17.   id_St2     = 402;
  18.   id_St3     = 403;
  19.   id_St4     = 404;
  20.  
  21. {******************************************************************}
  22. { Types                                                            }
  23. {******************************************************************}
  24. type
  25.     TPVApplication = object(TApplication)
  26.        procedure InitMainWindow;virtual;
  27.     end;
  28.  
  29. PPVDlg1 = ^TPVDlg1;
  30. TPVDlg1 = object(TDialog)
  31.     FontSize: Integer;
  32.     procedure WMInitDialog(var Msg:TMessage);virtual wm_First+wm_InitDialog;
  33.    procedure IDLb1(var Msg:TMessage);virtual id_First+id_Lb1;
  34.     end;
  35.  
  36. PPVDlg2 = ^TPVDlg2;
  37. TPVDlg2 = object(TDialog)
  38.     procedure WMInitDialog(var Msg:TMessage);virtual wm_First+wm_InitDialog;
  39.     end;
  40.  
  41. type                          {convert TLogFont records to objects}
  42. PFontItem = ^TFontItem;
  43. TFontItem = object(TObject)
  44.     LogFont:TLogFont;
  45.    FontType:Integer;
  46.    constructor Init(NewItem:TLogFont;NewType:Integer);
  47.    destructor Done;virtual;
  48. end;
  49.  
  50. PFontCollection = ^TFontCollection;
  51. TFontCollection = object(TSortedCollection)
  52.     function KeyOf(Item:Pointer):Pointer;virtual;
  53.    function Compare(Key1,Key2:Pointer):Integer;virtual;
  54.    function    GetCount:Integer;virtual;
  55. end;
  56.  
  57. type                            {Child win to display sample text}
  58.   PFontWindow = ^TFontWindow;
  59.   TFontWindow = object(TWindow)
  60.     FontsHeight: LongInt;
  61.     constructor Init(AParent: PWindowsObject; ATitle: PChar);
  62.     procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct); virtual;
  63.     procedure Destroy; virtual;
  64.     procedure WMSize(var Msg: TMessage);
  65.       virtual wm_First + wm_Size;
  66.   end;
  67.  
  68.  
  69. type                           {MainWindow of Application}
  70. PPVWindow = ^TPVWindow;
  71. TPVWindow = object(TWindow)
  72.     FWin:PFontWindow;
  73.    FBox:PListBox;
  74.    TheIcon:HIcon;
  75.    Bn1,Bn2,Bn3,Bn4,Bn5 :PODButton;
  76.    Dlg1 : PPVDlg1;        {Select font size dialog}
  77.    St1,St2,St3,St4:PStatic;
  78.    TextString:Array[0..80] of Char;    {to display in FWin}
  79.       FontSelection:Integer;              {Index into Fonts collection}
  80.    FontSize:Integer;         {Current font size desired}
  81.    FontMetrics:TTextMetric;  {Current font metrics}
  82.     constructor Init(AParent:PWindowsObject;ATitle:PChar);
  83.    destructor  Done;virtual;
  84.    procedure     SetupWindow;virtual;
  85.    procedure     Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);virtual;
  86.    procedure    LoadFBox;
  87.    procedure    WMDrawItem(var Msg:TMessage);virtual wm_First + wm_DrawItem;
  88.    procedure     WMSize(var Msg:TMessage);virtual wm_First+wm_Size;
  89.    procedure     WMSetFocus(var Msg:TMessage);virtual wm_First+wm_SetFocus;
  90.    procedure     IDBut1(var Msg:TMessage);virtual id_First+id_But1; {About}
  91.     procedure     IDBut2(var Msg:TMessage);virtual id_First+id_But2; {Size}
  92.    procedure     IDBut3(var Msg:TMessage);virtual id_First+id_But3; {String}
  93.    procedure    IDBut4(var Msg:TMessage);virtual id_First+id_But4; {Text Metrics}
  94.    procedure     IDBut5(var Msg:TMessage);virtual id_First+id_But5; {Exit}
  95.    procedure    IDLB2(var Msg:TMessage);virtual  id_First+id_lb2;
  96.    procedure     EnumerateFaces;virtual;
  97.    function        GetFontSelection:Integer;virtual;
  98.    function        GetFontSize:Integer;virtual;
  99.    function        GetTextString:PChar;virtual;
  100.    procedure    SetFontSize(NewfontSize:Integer);virtual;
  101. end;
  102.  
  103.  
  104. {********************************************************************}
  105. {G L O B A L  V A R I A B L E S                                      }
  106. {********************************************************************}
  107. var
  108.   Fonts:PFontCollection; {collection of PFontItem for call-back func}
  109.   Sizes:PStack;    {collection of Strings for call-back func}
  110.  
  111. {********************************************************************}
  112. {M E T H O D S                                                       }
  113. {********************************************************************}
  114.  
  115. procedure TPVApplication.InitMainWindow;
  116. begin
  117.     MainWindow := New(PPVWindow,Init(nil,'Font Preview'));
  118. end;
  119.  
  120. {********************************************************************}
  121. {Init}
  122. constructor TPVWindow.Init(AParent:PWindowsObject;ATitle:PChar);
  123. begin
  124.     TWindow.Init(AParent,ATitle);
  125.    Attr.Menu := 0;
  126.    Attr.X := 20; Attr.Y := 25; Attr.W := 595; Attr.H := 260;
  127.    Bn1 := New(PODButton,Init(@Self,id_But1,'Font Size',0,0,50,50,False,'PV_Bn1'));
  128.    Bn2 := New(PODButton,Init(@Self,id_But2,'Font Size',50,0,50,50,False,'PV_Bn2'));
  129.    Bn3 := New(PODButton,Init(@Self,id_But3,'String',100,0,100,50,False,'PV_Bn3'));
  130.    Bn4 := New(PODButton,Init(@Self,id_But4,'String',200,0,50,50,False,'PV_Bn4'));
  131.    Bn5 := New(PODButton,Init(@Self,id_But5,'Exit',250,0,50,50,False,'PV_Bn5'));
  132.    St1 := New(PStatic,Init(@Self,id_St1,'',315,5,240,18,75));
  133.    St2 := New(PStatic,Init(@Self,id_St2,'',315,26,240,18,75));
  134.    St3 := New(PStatic,Init(@Self,id_ST3,'',310,3,250,44,75));
  135.    St4 := New(PStatic,Init(@Self,id_St4,'',5,55,100,18,75));
  136.    St2^.Attr.Style := St2^.Attr.Style or ss_LeftNoWordWrap;
  137.    St3^.Attr.Style := St3^.Attr.Style or ss_BlackFrame;
  138.    St4^.Attr.Style := St4^.Attr.Style or ss_Left;
  139.    FontSelection := 0;
  140.    FontSize := 48;
  141.    StrCopy(TextString,'');
  142.    Fonts := New(PFontCollection,Init(100,100));
  143.    Fonts^.Duplicates := False;
  144.     Sizes := New(PStack,Init(10,10));
  145.    EnumerateFaces;
  146.    FWin := New(PFontWindow,Init(@Self,ATitle));
  147.    with FWin^.Attr do
  148.        Style := Style or ws_Child or ws_HScroll or ws_VScroll or ws_Border ;
  149.    FBox := New(PListBox,Init(@Self,id_lb2,0,0,0,0));
  150.    with FBox^.Attr do Style := Style and not lbs_Sort or lbs_nointegralheight  ;
  151. end;
  152.  
  153. {SetupWindow}
  154. procedure TPVWindow.SetupWindow;
  155. begin
  156.     TWindow.SetupWindow;
  157.     SetClassWord(HWindow,GCW_HIcon,LoadIcon(HInstance,'PV_Icon'));
  158.     LoadFBox;
  159. end;
  160.  
  161. {Paint}
  162. procedure TPVWindow.Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);
  163. var
  164.     ThePen:HPen;
  165.    TheBrush :HBrush;
  166.    OldBrush :HBrush;
  167.    OldPen:HPen;
  168.    OldBitMap:HBitMap;
  169.    MemDC :HDC;
  170.    CR:TRect;
  171.    W,H:Integer;
  172.    BMRec:TBitMap;
  173. begin
  174.     TheBrush := GetStockObject(LtGray_Brush);
  175.     ThePen := CreatePen(ps_Solid,1,$00000000);
  176.    OldPen := SelectObject(PaintDC,ThePen);
  177.    OldBrush := SelectObject(PaintDC,TheBrush);
  178.    GetClientRect(HWindow,CR);
  179.    Rectangle(PaintDC,CR.left,CR.Top,CR.right,50);
  180.    SelectObject(PaintDC,OldBrush);
  181.    SelectObject(PaintDC,OldPen);
  182.    DeleteObject(ThePen);
  183. end;
  184.  
  185. {Route the Ownerdraw msgs to correct object}
  186. procedure    TPVWindow.WMDrawItem(var Msg:TMessage);
  187. var
  188.     PDIS : ^TDrawItemStruct;
  189. begin
  190.     PDIS := Pointer(Msg.lParam);
  191.    case PDIS^.CtlType of
  192.        odt_Button:
  193.           case PDIS^.CtlID of
  194.                id_But1 :Bn1^.DrawItem(Msg);
  195.                id_But2 :Bn2^.DrawItem(Msg);
  196.                id_But3 :Bn3^.DrawItem(Msg);
  197.                 id_But4 :Bn4^.DrawItem(Msg);
  198.               id_But5 :Bn5^.DrawItem(Msg);
  199.          end;
  200.    end;
  201. end;
  202.  
  203.  
  204. {Done}
  205. destructor TPVWindow.Done;
  206. begin
  207.     Dispose(Sizes,Done);
  208.     TWindow.Done;
  209. end;
  210.  
  211. {WMSize}
  212. procedure TPVWindow.WMSize(var Msg:TMessage);
  213. begin
  214.     SetWindowPos(FBox^.HWindow,0,-1,75,(Msg.LParamLo div 3)+1,
  215.        ((Msg.LParamHi-75)  ),swp_NoZOrder);
  216.     SetWindowPos(FWin^.HWindow,0,(Msg.LParamLo  div 3)-1,49,
  217.        (Msg.LParamLo * 2 div 3)+1,(Msg.LParamHi-48),swp_NoZOrder);
  218. end;
  219.  
  220. {WMSetFocus}
  221. procedure TPVWindow.WMSetFocus(var Msg:TMessage);
  222. begin
  223.     SetFocus(FBox^.HWindow);
  224. end;
  225.  
  226. procedure TPVWindow.IDBut1(var Msg:TMessage);
  227. var
  228.     Dlg : PDialog;
  229. begin
  230.  
  231.     Dlg :=New(PDialog,Init(@Self,'PV_About'));
  232.     Application^.ExecDialog(Dlg);
  233. end;
  234.  
  235. {IDBut2} {run font size dialog box}
  236. procedure TPVWindow.IDBut2(var Msg:TMessage);
  237. begin
  238.     Dlg1 := new(PPVDlg1,Init(@Self,'PV_Dlg1'));
  239.    Application^.ExecDialog(Dlg1);
  240.    if (Dlg1^.FontSize) <> 0 then
  241.         InvalidateRect(Fwin^.HWindow,nil,True);
  242. end;
  243.  
  244. {IDBut3}   {run sample string dialog box}
  245. procedure TPVWindow.IDBut3(var Msg:TMessage);
  246. var
  247.     TotChars:Integer;
  248. begin
  249.    If Application^.ExecDialog(New(PInputdialog,Init(@Self,'Font String',
  250.        'Enter text:',TextString,SizeOf(TextString)))) = id_OK then
  251.     else StrCopy(TextString,'');
  252.    InvalidateRect(FWin^.HWindow,nil,True);
  253. end;
  254.  
  255. {IdBut4}  {GetTextMetrics}
  256. procedure TPVWindow.IDBut4(var Msg:TMessage);
  257. var
  258.     Dlg : PPVDlg2;
  259. begin
  260.     Dlg :=New(PPVDlg2,Init(@Self,'PV_Dlg2'));
  261.     Application^.ExecDialog(Dlg);
  262. end;
  263.  
  264. {IdBut5}  {exit}
  265. procedure TPVWindow.IDBut5(var Msg:TMessage);
  266. begin
  267.    SendMessage(HWindow,wm_Close,0,0);
  268. end;
  269.  
  270.  
  271. procedure TPVWindow.LoadFBox;
  272. var
  273.     Indx : Integer;
  274.    Font : PFontItem;
  275.    Buf1 :Array[0..20] of Char;
  276.    Buf2 :Array[0..5] of Char;
  277. begin
  278.     Str(Fonts^.Getcount,Buf2);
  279.     StrECopy(StrECopy(StrECopy(Buf1,'*'),Buf2),' Fonts*');
  280.    St4^.SetText(Buf1);
  281.     for indx := 0 to (Fonts^.GetCount -1) do
  282.        begin
  283.         Font := Fonts^.At(indx);
  284.        FBox^.InsertString(Font^.LogFont.lfFaceName,-1);
  285.       end;
  286. end;
  287.  
  288. procedure TPVWindow.IDLB2(var Msg:TMessage);
  289. var
  290.     szBuffer:Array[0..80] of Char;
  291.  
  292.    indx:Integer;
  293. begin
  294.     case Msg.lParamHi of
  295.        lbn_DblClk, lbn_SelChange:
  296.           begin
  297.           indx := FBox^.GetSelIndex;
  298.          FontSelection := Indx;
  299.          InvalidateRect(FWin^.HWindow,nil,True);
  300.          Exit;
  301.          end;
  302.    end;
  303. end;
  304.  
  305. function EnumerateFace(var LogFont: TLogFont; TextMetric: PTextMetric;
  306.   FontType: Integer; Data: PChar): Integer; export;
  307. var
  308.   OldFont: HFont;
  309. begin
  310.   Fonts^.Insert(New(PFontItem,Init(LogFont,FontType)));
  311.   EnumerateFace := 1;
  312. end;
  313.  
  314.  
  315. { Collect all of the system fonts }
  316. procedure TPVWindow.EnumerateFaces;
  317. var
  318.   EnumProc: TFarProc;
  319.   TheDC :HDC;
  320. begin
  321.     TheDC := GetDC(HWindow);
  322.     EnumProc := MakeProcInstance(@EnumerateFace, HInstance);
  323.     EnumFonts(TheDC, nil, EnumProc, nil);
  324.     ReleaseDC(HWindow, TheDC);
  325. end;
  326.  
  327. function TPVWindow.GetFontSelection:Integer;
  328. begin
  329.     GetFontSelection := FontSelection;
  330. end;
  331.  
  332. function TPVWindow.GetFontSize:Integer;
  333. begin
  334.     GetFontSize := FontSize;
  335. end;
  336.  
  337. function TPVWindow.GetTextString:PChar;
  338. begin
  339.     GetTextString := @TextString;
  340. end;
  341.  
  342. procedure TPVWindow.SetFontSize(NewFontSize:Integer);
  343. begin
  344.     FontSize := NewFontSize;
  345. end;
  346.  
  347. {***********************************************************************}
  348.  
  349. { Initialize object and collect font information }
  350. constructor TFontWindow.Init(AParent: PWindowsObject; ATitle: PChar);
  351.  
  352. begin
  353.   TWindow.Init(AParent, ATitle);
  354.   Attr.Style := Attr.Style or ws_VScroll or ws_HScroll or ws_Border;
  355.   FontsHeight := 0;
  356.   Scroller := New(PScroller, Init(@Self, 12, 12,0,0));
  357. end;
  358.  
  359. { Draw  font name in Window & update static text}
  360. procedure TFontWindow.Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);
  361. var
  362.   I: Integer;
  363.   VPosition: Integer;
  364.   FontItem :PFontItem;
  365.   FontSel:Integer;
  366.   AFont:HFont;
  367.   OldFont:HFont;
  368.   Extent:LongRec;
  369.   Text:Array[0..80] of Char;
  370.   Buf:Array[0..80] of Char;
  371.   szFH:Array[0..4] of Char;
  372. begin
  373.     FontItem := Fonts^.At(PPVWindow(Parent)^.GetFontSelection);
  374.    FontItem^.LogFont.lfHeight := PPVWindow(Parent)^.GetFontSize;
  375.    FontsHeight := PPVWindow(Parent)^.GetFontSize;
  376.    FontItem^.LogFont.lfWidth := 0;
  377.    FontItem^.LogFont.lfWeight := 0;
  378.    FontItem^.LogFont.lfQuality := Proof_Quality;
  379.    VPosition := 5;
  380.    if StrComp(PPVWindow(Parent)^.GetTextString,'') = 0
  381.        then StrCopy(Text,FontItem^.LogFont.lfFaceName)
  382.        else StrCopy(Text,PPVWindow(Parent)^.GetTextString);
  383.    AFont := CreateFontIndirect(FontItem^.LogFont);
  384.    OldFont := SelectObject(PaintDC, AFont);
  385.     GetTextMetrics(PaintDC,PPVWindow(Parent)^.FontMetrics);
  386.    LongInt(Extent) := GetTextExtent(PaintDC,Text,
  387.        StrLen(Text));
  388.    Scroller^.SetRange(Extent.lo div 12, Extent.Hi div 12);
  389.    TextOut(PaintDC, 10,VPosition, Text,
  390.       StrLen(Text));
  391.    StrCopy(Buf,'Face: ');
  392.     PPVWindow(Parent)^.St1^.SetText(StrCat(Buf,FontItem^.LogFont.lfFaceName));
  393.    Str(PPVWindow(Parent)^.FontMetrics.tmHeight:3,szFH);
  394.    StrECopy(StrECopy(Buf,'Size:'),szFH);
  395.    PPVWindow(Parent)^.St2^.SetText(Buf);
  396.    SelectObject(PaintDC,OldFont);
  397.    DeleteObject(AFont);
  398. end;
  399.  
  400. procedure TFontWindow.Destroy;
  401. begin
  402.   TWindow.Destroy;
  403. end;
  404.  
  405. procedure TFontWindow.WMSize(var Msg: TMessage);
  406. begin
  407.   TWindow.WMSize(Msg);
  408. end;
  409.  
  410. {***********************************************************************}
  411. constructor TFontItem.Init(NewItem:TLogFont;NewType:Integer);
  412. begin
  413.     LogFont := NewItem;
  414.    FontType := NewType;
  415. end;
  416.  
  417. destructor TFontItem.Done;
  418. begin
  419. end;
  420.  
  421.  
  422. {***********************************************************************}
  423. function TFontCollection.KeyOf(Item:Pointer):Pointer;
  424. var
  425.    Ptr :PChar;
  426. begin
  427.     Ptr := PFontItem(Item)^.LogFont.lfFaceName;
  428.     KeyOf := Ptr;
  429. end;
  430.  
  431.  
  432. function TFontCollection.Compare(Key1,Key2:Pointer):Integer;
  433. begin
  434.     Compare := StrIComp(PChar(Key1),PChar(Key2));
  435. end;
  436.  
  437.  
  438. function TFontCollection.GetCount:Integer;
  439. begin
  440.     GetCount := Count;
  441. end;
  442.  
  443. {***********************************************************************}
  444. procedure TPVDlg1.IDLb1(var Msg:TMessage);
  445. var
  446.     Idx : Integer;
  447.    Buf:Array[0..5] of Char;
  448.    Ptr : PChar;
  449.    ErrCode:Integer;
  450. begin
  451.     case Msg.lParamHi of
  452.     lbn_SelChange,lbn_DblClk:
  453.        begin
  454.       Ptr := Buf;
  455.       Idx := SendDlgItemMsg(id_Lb1,lb_GetCurSel,0,0);
  456.       SendDlgItemMsg(id_Lb1,lb_GetText,word(Idx),LongInt(Ptr));
  457.        val(Ptr,FontSize,ErrCode);
  458.       PPVWindow(Parent)^.SetFontSize(FontSize);
  459.       EndDlg(Idx);
  460.       Exit;
  461.       end;
  462.    end;
  463. end;
  464.  
  465.  
  466. function EnumerateSize(var LogFont: TLogFont; TextMetric: PTextMetric;
  467.   FontType: Integer; Data: PChar): Integer; export;
  468. var
  469.     FHeight:Array[0..6] of Char;
  470. begin
  471.     Str(LogFont.lfHeight:3,FHeight);
  472.     Sizes^.Push(New(PStackStr,Init(FHeight)));
  473.     EnumerateSize := 1;
  474. end;
  475.  
  476.  
  477.  
  478. procedure TPVDlg1.WMInitDialog(var Msg:TMessage);
  479. var
  480.     pTextItem:PChar;
  481.    Buf:Array[0..3] of Char;
  482.     Indx:Integer;
  483.    DSN,ErrCode :Integer;
  484.    EnumProc:TFarProc;
  485.    TheDC:HDc;
  486.    FontItem:PFontItem;
  487.    Item:PStackStr;
  488. begin
  489.     TDialog.WMInitDialog(Msg);
  490.    Sizes^.DeleteAll;
  491.    FontItem := Fonts^.At(PPVWindow(Parent)^.GetFontSelection);
  492.  
  493.    TheDC := GetDC(HWindow);
  494.    EnumProc := MakeProcInstance(@EnumerateSize, HInstance);
  495.    EnumFonts(TheDC, FontItem^.LogFont.lfFaceName, EnumProc, nil);
  496.    ReleaseDC(HWindow, TheDC);
  497.  
  498.    Indx := 12;
  499.    pTextItem := Buf;
  500.  
  501.    if FontItem^.FontType <> 1 then
  502.        begin
  503.        Str(Indx:3,Buf);
  504.        while Indx < 200 do
  505.            begin
  506.            SendDlgItemMsg(id_Lb1,lb_AddString,word(0),LongInt(pTextItem));
  507.             Indx := Indx + 12;
  508.           Str(Indx:3,Buf);
  509.            end;
  510.        end
  511.    else
  512.        while Sizes^.Count > 0 do
  513.           begin
  514.          Item := Sizes^.Pop;
  515.               StrCopy(Buf,Item^.StackStr);
  516.               Dispose(Item,Done);
  517.            SendDlgItemMsg(id_Lb1,lb_AddString,word(0),LongInt(pTextItem));
  518.           end;
  519. end;
  520.  
  521. {***********************************************************************}
  522.  
  523. procedure TPVDlg2.WMInitDialog(var Msg:TMessage);
  524. const
  525.     FontFamily : Array[0..5,0..11] of Char = ('Don''t Care', '     Roman',
  526.                    '     Swiss','    Modern', '    Script', 'Decorative');
  527. var
  528.     FontItem:PFontItem;
  529.     TextItem:PChar;
  530.    Buf:Array[0..3] of Char;
  531.    FontMetrics:TTextMetric;
  532.  
  533. begin
  534.     FontMetrics :=PPVWindow(Parent)^.FontMetrics;
  535.     TDialog.WMInitDialog(Msg);
  536.     FontItem := Fonts^.At(PPVWindow(Parent)^.GetFontSelection);
  537.    SetDlgItemText(HWindow,601,FontItem^.LogFont.lfFaceName);
  538.  
  539.    Str(FontMetrics.tmHeight:3,Buf); SetDlgItemText(HWindow,612,Buf);
  540.    Str(FontMetrics.tmAscent:3,Buf); SetDlgItemText(HWindow,613,Buf);
  541.    Str(FontMetrics.tmDescent:3,Buf); SetDlgItemText(HWindow,614,Buf);
  542.    Str(FontMetrics.tmInternalLeading:3,Buf); SetDlgItemText(HWindow,615,Buf);
  543.    Str(FontMetrics.tmExternalLeading:3,Buf); SetDlgItemText(HWindow,616,Buf);
  544.    Str(FontMetrics.tmAveCharWidth:3,Buf); SetDlgItemText(HWindow,617,Buf);
  545.    Str(FontMetrics.tmMaxCharWidth:3,Buf); SetDlgItemText(HWindow,618,Buf);
  546.    Str(FontMetrics.tmWeight:3,Buf); SetDlgItemText(HWindow,619,Buf);
  547.    Str(FontMetrics.tmItalic:3,Buf); SetDlgItemText(HWindow,620,Buf);
  548.    Str(FontMetrics.tmUnderlined:3,Buf); SetDlgItemText(HWindow,621,Buf);
  549.  
  550.    Str(FontMetrics.tmStruckOut:3,Buf); SetDlgItemText(HWindow,632,Buf);
  551.    Str(FontMetrics.tmFirstChar:3,Buf); SetDlgItemText(HWindow,633,Buf);
  552.    Str(FontMetrics.tmLastChar:3,Buf); SetDlgItemText(HWindow,634,Buf);
  553.    Str(FontMetrics.tmDefaultChar:3,Buf); SetDlgItemText(HWindow,635,Buf);
  554.    if FontMetrics.tmPitchandFamily and 1 > 0 then SetDlgItemText(HWindow,636,'Variable')
  555.        else SetDlgItemText(HWindow,636,'Fixed');
  556.     SetDlgItemText(HWindow,637,FontFamily[FontMetrics.tmPitchAndFamily shr 4] );
  557.    if FontMetrics.tmCharSet = ANSI_CharSet  then SetDlgItemText(HWindow,638,'Ansi')
  558.    else if FontMetrics.tmCharSet = OEM_CharSet  then SetDlgItemText(HWindow,638,'OEM')
  559.    else if FontMetrics.tmCharSet = Symbol_CharSet  then SetDlgItemText(HWindow,638,'Symbol')
  560.    else if FontMetrics.tmCharSet = ShiftJis_CharSet  then SetDlgItemText(HWindow,638,'ShiftJis')
  561.    else SetDlgItemText(HWindow,638,' ');
  562.    Str(FontMetrics.tmOverHang:3,Buf); SetDlgItemText(HWindow,639,Buf);
  563.    Str(FontMetrics.tmDigitizedAspectX:3,Buf); SetDlgItemText(HWindow,640,Buf);
  564.    Str(FontMetrics.tmDigitizedAspectY:3,Buf); SetDlgItemText(HWindow,641,Buf);
  565. end;
  566.  
  567.  
  568.  
  569. {*********************************************************************}
  570. {*** M A I N L I N E                                                  }
  571. {*********************************
  572. ***********************************}
  573. var
  574.     PVApp : TPVApplication;
  575. begin
  576.     PVApp.Init('A Font Preview');
  577.    PVApp.Run;
  578.     PVApp.Done;
  579. end.
  580.